home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Icon 8.1 / mep1 / Samples / Programs / ipxref.icn < prev    next >
Encoding:
Text File  |  1990-11-23  |  6.7 KB  |  230 lines  |  [TEXT/PICN]
  1. ############################################################################
  2. #
  3. #    Name:    ipxref.icn
  4. #
  5. #    Title:    Produce cross reference for Icon program
  6. #
  7. #    Author:    Allan J. Anderson
  8. #
  9. #    Date:    June 10, 1988
  10. #
  11. ############################################################################
  12. #  
  13. #     This program cross-references Icon programs. It lists the
  14. #  occurrences of each variable by line number. Variables are listed
  15. #  by procedure or separately as globals.  The options specify the
  16. #  formatting of the output and whether or not to cross-reference
  17. #  quoted strings and non-alphanumerics. Variables that are followed
  18. #  by a left parenthesis are listed with an asterisk following the
  19. #  name.  If a file is not specified, then standard input is cross-
  20. #  referenced.
  21. #  
  22. #  Options: The following options change the format defaults:
  23. #  
  24. #       -c n The column width per line number. The default is 4
  25. #            columns wide.
  26. #  
  27. #       -l n The starting column (i.e. left margin) of the line
  28. #            numbers.  The default is column 40.
  29. #  
  30. #       -w n The column width of the whole output line. The default
  31. #            is 80 columns wide.
  32. #  
  33. #     Normally only alphanumerics are cross-referenced. These
  34. #  options expand what is considered:
  35. #  
  36. #       -q   Include quoted strings.
  37. #  
  38. #       -x   Include all non-alphanumerics.
  39. #  
  40. #  Note: This program assumes the subject file is a valid Icon pro-
  41. #  gram. For example, quotes are expected to be matched.
  42. #  
  43. ############################################################################
  44. #
  45. #  Links: getopt
  46. #
  47. ############################################################################
  48.  
  49. link getopt
  50.  
  51. global resword, linenum, letters, alphas, var, buffer, qflag, infile, xflag
  52. global inmaxcol, inlmarg, inchunk, localvar, lin
  53.  
  54. record procrec(pname,begline,lastline)
  55.  
  56. procedure main(args)
  57.  
  58.    local word, w2, p, prec, i, L, ln
  59.  
  60.    resword := ["break","by","case","default","do","dynamic","else","end",
  61.       "every","fail","global","if","initial","link", "local","next","not",
  62.       "of","procedure", "record","repeat","return","static","suspend","then",
  63.       "to","until","while"]
  64.    linenum := 0
  65.    var := table()        # var[variable[proc]] is list of line numbers
  66.    prec := []        # list of procedure records
  67.    localvar := []        # list of local variables of current routine
  68.    buffer := []        # a put-back buffer for getword
  69.    proc := "global"
  70.    letters := &letters ++ '_'
  71.    alphas := letters ++ &digits
  72.  
  73.    opts := getopt(args,"qxw+l+c+")
  74.    switches := opts[1]
  75.  
  76.    if \switches["-q"] then qflag := 1
  77.    if \switches["-x"] then xflag := 1
  78.    inmaxcol := \switches["w"]
  79.    inlmarg := \switches["l"]
  80.    inchunk := \switches["c"]
  81.    infile := open(opts[2][1],"r")     # could use some checking
  82.  
  83.    while word := getword() do
  84.       if word == "link" then {
  85.          buffer := []
  86.          lin := ""
  87.          next
  88.          }
  89.       else if word == "procedure" then {
  90.          put(prec,procrec("",linenum,0))
  91.          proc := getword() | break
  92.          p := pull(prec)
  93.          p.pname := proc
  94.          put(prec,p)
  95.          }
  96.       else if word == ("global" | "link" | "record") then {
  97.          word := getword() | break
  98.          addword(word,"global",linenum)
  99.          while (w2 := getword()) == "," do {
  100.             if word == !resword then break
  101.             word := getword() | break
  102.             addword(word,"global",linenum)
  103.             }
  104.          put(buffer,w2)
  105.          }
  106.       else if word == ("local" | "dynamic" | "static") then {
  107.          word := getword() | break
  108.          put(localvar,word)
  109.          addword(word,proc,linenum)
  110.          while (w2 := getword()) == "," do {
  111.             if word == !resword then break
  112.             word := getword() | break
  113.             put(localvar,word)
  114.             addword(word,proc,linenum)
  115.             }
  116.          put(buffer,w2)
  117.          }
  118.       else if word == "end" then {
  119.          proc := "global"
  120.          localvar := []
  121.          p := pull(prec)
  122.          p.lastline := linenum
  123.          put(prec,p)
  124.          }
  125.       else if word == !resword then 
  126.          next
  127.       else {
  128.          ln := linenum
  129.          if (w2 := getword()) == "(" then
  130.             word ||:= " *"            # special mark for procedures
  131.          else
  132.             put(buffer,w2)            # put back w2
  133.          addword(word,proc,ln)
  134.          }
  135.    every write(!format(var))
  136.    write("\n\nprocedures:\tlines:\n")
  137.    L := []
  138.    every p := !prec do
  139.       put(L,left(p.pname,16," ") || p.begline || "-" || p.lastline)
  140.    every write(!sort(L))
  141. end
  142.  
  143. procedure addword(word,proc,lineno)
  144.    if any(letters,word) | \xflag then {
  145.       /var[word] := table()
  146.       if /var[word]["global"] | (word == !\localvar) then {
  147.          /(var[word])[proc] := [word,proc]
  148.          put((var[word])[proc],lineno)
  149.          }
  150.       else {
  151.          /var[word]["global"] := [word,"global"]
  152.          put((var[word])["global"],lineno)
  153.          }
  154.       }
  155. end
  156.  
  157. procedure getword()
  158.    local j, c
  159.    static i, nonwhite
  160.    initial nonwhite := ~' \t\n'
  161.  
  162.    repeat {
  163.       if *buffer > 0 then return get(buffer)
  164.       if /lin | i = *lin + 1 then
  165.          if lin := read(infile) then {
  166.             i := 1
  167.             linenum +:= 1
  168.             }
  169.          else fail
  170.       if i := upto(nonwhite,lin,i) then {   # skip white space
  171.          j := i
  172.          if lin[i] == ("'" | "\"") then {   # don't xref quoted words
  173.             if /qflag then {
  174.                c := lin[i]
  175.                i +:= 1
  176.                repeat
  177.                   if i := upto(c ++ '\\',lin,i) + 1 then
  178.                      if lin[i - 1] == c then break
  179.                      else i +:= 1
  180.                   else {
  181.                      i := 1
  182.                      linenum +:= 1
  183.                      lin := read(nfile) | fail
  184.                      }
  185.                }
  186.             else i +:= 1
  187.             }
  188.          else if lin[i] == "#" then {    # don't xref comments; get next line
  189.             i := *lin + 1
  190.             }
  191.          else if i := many(alphas,lin,i) then
  192.             return lin[j:i]
  193.          else {
  194.             i +:= 1
  195.             return lin[i - 1]
  196.             }
  197.          }
  198.       else
  199.          i := *lin + 1
  200.    }       # repeat
  201. end
  202.  
  203. procedure format(T)
  204.    local V, block, n, L, lin, maxcol, lmargin, chunk, col
  205.    initial {
  206.       maxcol := \inmaxcol | 80
  207.       lmargin := \inlmarg | 40
  208.       chunk := \inchunk | 4
  209.       }
  210.    L := []
  211.    col := lmargin
  212.    every V := !T do
  213.       every block := !V do {
  214.          lin := left(block[1],16," ") || left(block[2],lmargin - 16," ")
  215.          every lin ||:= center(block[3 to *block],chunk," ") do {
  216.             col +:= chunk
  217.             if col >= maxcol - chunk then {
  218.                lin ||:= "\n\t\t\t\t\t"
  219.                col := lmargin
  220.                }
  221.             }
  222.          if col = lmargin then lin := lin[1:-6] # came out exactly even
  223.          put(L,lin)
  224.          col := lmargin
  225.          }
  226.    L := sort(L)
  227.    push(L,"variable\tprocedure\t\tline numbers\n")
  228.    return L
  229. end
  230.